home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / DELPHI.SWG / 0008_Mixed fonts in TMEMO.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  1.6 KB  |  70 lines
  1.  
  2. {
  3.  > Has anyone got a way around having mixed fonts within a memo component ?
  4.  
  5. You can use this rough TMemo derivative to experiment: }
  6.  
  7.   unit Todrmemo;
  8.  
  9.   interface
  10.  
  11.   uses
  12.     SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  13.     Forms, Dialogs, StdCtrls;
  14.  
  15.   type
  16.     TOwnerDrawMemo = class(TMemo)
  17.     private
  18.       { Private declarations }
  19.       procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  20.     protected
  21.       { Protected declarations }
  22.     public
  23.       { Public declarations }
  24.     published
  25.       { Published declarations }
  26.     end;
  27.  
  28.   procedure Register;
  29.  
  30.   implementation
  31.  
  32.   procedure TOwnerDrawMemo.WMPaint(var Message: TWMPaint);
  33.   var Buffer: Array[0..255] of Char;
  34.       PS: TPaintStruct;
  35.       DC: HDC;
  36.       i: Integer;
  37.       X,Y,Z: Word;
  38.       OldColor: LongInt;
  39.   begin
  40.     DC := Message.DC;
  41.     if DC = 0 then DC := BeginPaint(Handle, PS);
  42.     try
  43.       X := 1;
  44.       Y := 1;
  45.       SetBkColor(DC, Color);
  46.       SetBkMode(DC, Transparent);
  47.       { SetFont something or the other here... }
  48.       OldColor := Font.Color;
  49.       for i:=0 to Pred(Lines.Count) do
  50.       begin
  51.         if odd(i) then SetTextColor(DC, clRed)
  52.                   else SetTextColor(DC, OldColor);
  53.         Z := Length(Lines[i]);
  54.         StrPCopy(Buffer, Lines[i]);
  55.         Buffer[Z] := #0; { not really needed }
  56.         TextOut(DC, X,Y, Buffer, Z);
  57.         Inc(Y, abs(Font.Height));
  58.       end;
  59.     finally
  60.       if Message.DC = 0 then EndPaint(Handle, PS);
  61.     end;
  62.   end;
  63.  
  64.   procedure Register;
  65.   begin
  66.     RegisterComponents('Dr.Bob', [TOwnerDrawMemo]);
  67.   end;
  68.  
  69.   end.
  70.